home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "MTimer"
- Option Explicit
-
- Const cTimerMax = 100
-
- ' Array of timers
- Public aTimers(1 To cTimerMax) As CTimer
-
- Function TimerCreate(timer As CTimer) As Boolean
- ' Create the timer
- timer.TimerID = SetTimer(0&, 0&, timer.Interval, AddressOf TimerProc)
- If timer.TimerID Then
- TimerCreate = True
- Dim i As Integer
- For i = 1 To cTimerMax
- If aTimers(i) Is Nothing Then
- Set aTimers(i) = timer
- TimerCreate = True
- Exit Function
- End If
- Next
- timer.ErrRaise eeTooManyTimers
- Else
- ' TimerCreate = False
- timer.TimerID = 0
- timer.Interval = 0
- End If
- End Function
-
- Public Function TimerDestroy(timer As CTimer) As Long
- ' TimerDestroy = False
- ' Find and remove this timer
- Dim i As Integer, f As Boolean
- For i = 1 To cTimerMax
- ' Find timer in array
- If Not aTimers(i) Is Nothing Then
- If timer.TimerID = aTimers(i).TimerID Then
- f = KillTimer(hNull, timer.TimerID)
- ' Remove timer and set reference to nothing
- Set aTimers(i) = Nothing
- TimerDestroy = True
- Exit Function
- End If
- Else
- TimerDestroy = True
- Exit Function
- End If
- Next
- End Function
-
-
- Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
- ByVal idEvent As Long, ByVal dwTime As Long)
- Dim i As Integer
- ' Find the timer with this ID
- For i = 1 To cTimerMax
- If idEvent = aTimers(i).TimerID Then
- ' Generate the event
- aTimers(i).PulseTimer
- Exit Sub
- End If
- Next
- End Sub
-
-
- Private Function StoreTimer(timer As CTimer)
- Dim i As Integer
- For i = 1 To cTimerMax
- If aTimers(i) Is Nothing Then
- Set aTimers(i) = timer
- StoreTimer = True
- Exit Function
- End If
- Next
- End Function
-
-
-